home *** CD-ROM | disk | FTP | other *** search
/ Popular Request / By Popular Request (Arsenal Computer)(SysOptics Distribution System).ISO / amiga2 / killer21.lha / killer next >
Text File  |  1994-01-11  |  12KB  |  482 lines

  1. /***********************************************\
  2. * Killer V2.1 (c)11.12.1993 by Quickfinger      *
  3. * Bei Problemen oder Sonderwuenschen einfach    *
  4. * Paranoia Complex BBS +49(0)6251-75324 anrufen *
  5. * Das Programm bitte nicht veraendern.          *
  6. * Einfach vom BBSmenu aus starten               *
  7. * CNET 2.96 and higher (maybe lower).           *
  8. \***********************************************/
  9.  
  10. options results
  11. quick=0
  12. getuser 1100452 ; bbstext=result
  13. getuser 15 ; ag=result
  14. getuser 40 ; acn=result
  15. getuser 1307363 ; behind=upper(result)
  16. getuser 1 ; handle=upper(result)
  17. getuser 1310882 ; nname=result
  18. namenlen=length(handle)
  19.  
  20.  
  21.  
  22. /****************************************************************/
  23. /* CONFIGURATION HERE!! DON'T CHANGE --ANYTHING-- ELSE !!!   */
  24.  
  25.  
  26. sysop=23            /* Access group of sysop */
  27. ack.0="y"           /* Acknowledge (Yes, Ja, Oui,...) of bbstext 0  LOWER CASE! */
  28. ack.1="j"           /* Acknowledge (Yes, Ja, Oui,...) of bbstext 1  LOWER CASE! */
  29. passwort="LMAA"     /* Level1 Password */
  30. pcode="LMAB"        /* Level2 Password */
  31. frat=3              /* Standard uploadratio FILE (here 1:3) */
  32. brat=5              /* Standard uploadratio BYTE (here 1:5) */
  33. menupath="pfiles:utis/killer.menu"
  34.  
  35. /*** CONSTRUCTION OF DEFAULTS ****
  36.  
  37. d.0="No"     Delete file="Yes"; don't delete File="No"
  38. b.0=x        Subtract bytes x times (negative for REWARD)
  39. f.0=x        Subtract files x times (negative for REWARD)
  40. t.0="cause"  Cause to be displayed in the Filelist
  41.  
  42. maximum sets are 12, don't forget to change the >killer.menu< text
  43.  
  44. ****END OF EXAMPLE****/
  45.  
  46. d.1="No"
  47. b.1=-3
  48. f.1=-1
  49. t.1="YEAH COOL U/L!"
  50.  
  51. d.2="No"
  52. b.2=1
  53. f.2=1
  54. t.2="NO SENDERNAMES"
  55.  
  56. d.3="No"
  57. b.3=2
  58. f.3=1
  59. t.3="NO BBS-ADDIES!"
  60.  
  61. d.4="No"
  62. b.4=2
  63. f.4=2
  64. t.4="WRONG/NO PACK!"
  65.  
  66. d.5="No"
  67. b.5=3
  68. f.5=2
  69. t.5="INCOMPLETE!"
  70.  
  71. d.6="Yes"
  72. b.6=5
  73. f.6=3
  74. t.6="CORRUPT!"
  75.  
  76. d.7="Yes"
  77. b.7=5
  78. f.7=3
  79. t.7="HERE SINCE DAYS"
  80.  
  81. d.8="Yes"
  82. b.8=5
  83. f.8=3
  84. t.8="WRONG LANGUAGE"
  85.  
  86. d.9="Yes"
  87. b.9=5
  88. f.9=3
  89. t.9="ANCIENT AS HELL"
  90.  
  91. d.10="Yes"
  92. b.10=5
  93. f.10=3
  94. t.10="UNFINISHED!"
  95.  
  96. d.11="Yes"
  97. b.11=6
  98. f.11=6
  99. t.11="NO PD/SW/FW!!!!"
  100.  
  101. d.12="Yes"
  102. b.12=99
  103. f.12=99
  104. t.12="REAL DAMN CRAP!"
  105.  
  106.  
  107. /* END OF CONFIGURATION PART - NOTHING TO BE CHANGED AFTER THIS LINE */
  108.  
  109.  
  110. ack=ack.bbstext
  111. ackc=upper(ack)
  112.  
  113. if behind="CLEAR" then do
  114.     getuser 1310882 ; name=result
  115.     getuser 1306724 ; path=result
  116.     name=path"data/"name".nuk"
  117.     prompt 2 yesno "n1Clear CURRENT NUKE-Entry ("ackc"/n)?:" ; janein=result
  118.     if janein="Yes" then do
  119.         com="c:delete "name
  120.         address command com
  121.         transmit "n1done!"
  122.     end
  123.     call ende
  124. end
  125. if ag=sysop & behind="CLALL" then do
  126.     getuser 1310882 ; name=result
  127.     getuser 1306724 ; path=result
  128.     getuser 1306724 ; path=result
  129.     name=path"data/"
  130.     prompt 2 noyes "n1Clear ALL NUKE-Entries ("ack"/N)?:" ; janein=result
  131.     if janein="Yes" then do
  132.         com="c:delete "name"#?.nuk"
  133.         address command com
  134.         transmit "n1done!"
  135.     end
  136.     call ende
  137. end
  138.  
  139. passwort=upper(passwort)
  140. line1=""
  141.  
  142. if ag~=sysop then do
  143.     prompt 8 hide "n1Passwort: " ; pw=result
  144.     if pw~=passwort then do
  145.         transmit "n1Ask the sysop for the correct password."
  146.         call ende
  147.     end
  148. end
  149.  
  150.  
  151. /*** menu hier rein ***/
  152. menu:
  153. sendfile menupath
  154. prompt 2 normal "n1Choose a nukecause:" ; wahl=result
  155.  
  156. if wahl=14 then do
  157.     if ag~=23 then do
  158.         prompt 8 hide "n1Enter passcode to use non-default setting: " ;pc=result
  159.         if upper(pc)~=upper(pcode) then do
  160.             transmit "n1Ask the sysop for the correct passcode."
  161.             call ende
  162.         end
  163.     end
  164.     quick=0
  165.     call weiter
  166. end
  167.  
  168. if wahl=13 then do
  169.    d.wahl=getclip("kill")
  170.     b.wahl=getclip("btimes")
  171.     f.wahl=getclip("ftimes")
  172.     t.wahl=getclip("caustext")
  173.     quick=1 
  174.     call weiter
  175. end
  176. if wahl>-1 & wahl<13 then do
  177.     quick=1
  178.     call weiter
  179. end
  180.  
  181. call ende
  182. /********** menu ende ****/
  183. weiter:
  184. getuser 1310882 ; name=result
  185. getuser 1306724 ; path=result
  186. getuser 1305896 ; info=left(result,78)
  187. getuser 84      ; size=result
  188. getuser 1511084 ; date=result
  189. getuser 2400088 ; userzahl=result
  190. getuser 1410922 ; byacc=result
  191. datum=date()
  192. zeit=time()
  193. loadscratch byacc
  194. getscratch 1 ; byname=result
  195. getscratch 1300744 ; user=result
  196. getscratch 34 ; fcredits=result
  197. getscratch 35 ; bcredits=result
  198. savescratch byacc
  199.  
  200. pfad2file=path""name
  201.  
  202. transmit "f1n1Do you really want to c1NUKEc7 the following file?:n1"
  203. transmit "File Information:"
  204. transmit "-----------------"
  205. transmit "c2Path to File    :c7"pfad2file
  206. transmit "c2Size            :c7"size
  207. transmit "c2Uploaded by     :c7"user","byacc
  208. transmit "c2Date of Upload  :c7"date
  209. transmit "c2Description     :c7n2"info" ..."
  210. transmit "n1"
  211.  
  212. if quick=1 then do
  213.     janein=d.wahl
  214.     call p1
  215. end
  216.  
  217. prompt 2 noyes "n1Delete File from HD....("ack"/N)?:" ; janein=result
  218. setclip("kill",d.wahl)
  219. p1:
  220. if janein="Yes" then do
  221.     setclip("kill",janein)
  222.     com="c:delete "pfad2file
  223.     address command com
  224.     sendstring "n1Killing...."
  225.  
  226.     transmit "....done!"
  227.     address command kill
  228. end
  229.  
  230. if quick=1 then do
  231.     janein="Yes"
  232.     call p2
  233. end
  234.  
  235. prompt 2 noyes "n1Reduce/Reward Credits  ("ack"/N)?:" ; janein=result
  236. p2:
  237. if janein="Yes" then do
  238.     call reduce
  239. end
  240. if janein="No" then do
  241.     call mail
  242. end
  243.  
  244.  
  245.  
  246.  
  247.  
  248.  
  249. reduce:
  250. if quick=1 then do
  251.     btimes=b.wahl
  252.     ftimes=f.wahl
  253.     call p3
  254. end
  255. transmit "n1c2Please use the amounts stated in the main menu:c7"
  256. prompt 3 normal "n1How many times byte  (c3-c7 = reward)? :" ; btimes=result
  257. prompt 3 normal "n1How many times file? (c3-c7 = reward=? :" ; ftimes=result
  258.  
  259. setclip("btimes",btimes)
  260. setclip("ftimes",ftimes)
  261. p3:
  262. if upper(byname)=upper(handle) & ag~=sysop & btimes<0 & ftimes<0 then do
  263.     transmit "n1Sorry, you must not reward your own files!"
  264.     call ende
  265. end
  266. if ftimes="" | btimes="" then do
  267.     call ende
  268. end
  269. transmit "n1User's Credits.......(byte/file):    "bcredits"    "fcredits
  270. transmit "Deducting............(byte/file):    "size*btimes"    "1*ftimes
  271. transmit "User's New Credits...(byte/file):    "bcredits-size*btimes"    "fcredits-ftimes
  272. if quick~=1 then do
  273.     transmit "n1RETURN=CONTINUEg1"
  274. end
  275. bcredsneu=bcredits-size*btimes
  276. fcredsneu=fcredits-ftimes
  277. bweg=size*btimes
  278. fweg=ftimes
  279.  
  280. loadscratch byacc
  281.     setobject bcredsneu
  282.     putscratch 35
  283. savescratch byacc
  284.  
  285. loadscratch byacc
  286.     setobject fcredsneu
  287.     putscratch 34
  288. savescratch byacc
  289.  
  290. sendstring "n1Reducing credits....." ; sendstring "....done!n1"
  291.  
  292. if sysop=ag then do
  293.     prompt 2 yesno "n1Scan for possible downloads ("ackc"/n)):" ; janein=result
  294.     if janein="No" then do
  295.         noreturn=1
  296.         call nachreturn
  297.     end
  298. end
  299.  
  300. /**************CREDIT RETURNER START***************/
  301. return:
  302. transmit "n1Scanning for possible downloadersn1If handlesearch appears, just hit RETURN..."
  303. zahl=0
  304. count=0
  305. returnfile=1
  306. returnbyte=size
  307. filename=upper(name)
  308. if exists("sysdata:log/dloads")=0 then do
  309.     transmit "n1Downloadlog does not exist!"
  310.     exit
  311. end
  312.  
  313. open("i","sysdata:log/dloads","R")
  314. do until eof("i")=1
  315.     zahl=zahl+1
  316.     zeile.zahl=upper(readln("i"))
  317.     if index(zeile.zahl,filename)>0 then do
  318.         count=count+1
  319.         name.count=left(zeile.zahl,40)
  320.         name.count=right(name.count,21)
  321.         name.count=strip(name.count,"T")
  322.         findaccount name.count ; account.count=result
  323.         if account.count=0 then do
  324.             count=count-1
  325.         end
  326.     end
  327.     if right(z,1)=0 then do
  328.         sendstring "c7."    
  329.     end
  330. end
  331. close("i")
  332.  
  333. do a=1 to count
  334.     sendstring "Returning credits to "name.a"..." 
  335.     loadscratch account.a
  336.         getscratch 34 ; userfcred=result
  337.         getscratch 35 ; userbcred=result
  338.         userfcred=userfcred+returnfile
  339.         userbcred=userbcred+returnfile
  340.         setobject userfcred
  341.         putscratch 34
  342.         setobject userbcred
  343.         putscratch 35
  344.     savescratch account.a
  345.     transmit "...returned              ^1"
  346. end
  347. /**************CREDIT RETURNER ENDE***************/
  348.  
  349. nachreturn:
  350.  
  351.  
  352. if quick=1 then do
  353.     janein="Yes"
  354.     call nuke
  355. end
  356. prompt 2 noyes "n1Nuke in Filescan       ("ack"/N)?:"; janein=result
  357. if janein="Yes" then do
  358.     call nuke
  359. end
  360. if janein="No" then do
  361.     call mail
  362. end
  363.  
  364. nuke:
  365.  
  366. cause=0
  367. getuser 1306724 ; path=result
  368. getuser 1306724 ; path=result
  369. name=path"data/"nname".nuk"
  370. if quick=1 then do
  371.    causetext.=t.wahl
  372.     call p6
  373. end
  374. transmit "n1Select Nukecause:n21=Old, 2=Ancient, 3=Lame, 4=Fake, 5=Reward, 6=<own>"
  375. causetext.="NO CAUSE!!!"
  376. prompt 1 normal "n1Select cause (1-6):" ; cause=result
  377. p6:    
  378. if cause>0 & cause<7 then do
  379.     if cause=6 then do
  380.         mass="<"
  381.         do a=1 to 24-namenlen
  382.             mass=mass"-"
  383.         end
  384.         mass=mass">"
  385.         prompt 26-namenlen normal "n1Enter the Titel of deletion (max. "26-namenlen" chars)n1 "mass"n1:"; causetext.6=upper(result)
  386.         if causetext="" then do
  387.             causetext.6="NO CAUSE!!!"
  388.             transmit "Allright, nothing."
  389.         end
  390.     end
  391. end            
  392. causetext.1="VERY OLD!!!"
  393. causetext.2="ANCIENT!!!!"
  394. causetext.3="LAME!!!!!!!"
  395. causetext.4="FAKE!!!!!!!"
  396. causetext.5="VERY GOOD!!"
  397. setclip("caustext",causetext.cause)
  398. line1="^1>34}c7>>>>>>c2 "left(handle,namenlen)": c1"left(causetext.cause,26-namenlen)" c7<<<<<<c7"
  399. mass="<-------------------------->"
  400. prompt 28 normal "n1Enter OPTIONAL nukemessage, blank to skip:n1 "mass"n1:" ; nukemess=upper(left(result,28))
  401. setclip("nukemessage",nukemess)
  402. if nukemess~="" then do
  403.     line1=line1"n1>34}c7>>>>>>c2 "nukemess" c7<<<<<<c7"
  404. end
  405.     btimes=left(btimes,2)
  406.     ftimes=left(ftimes,2)
  407.     word="n1>34}c7>>>>>> c1"right(btimes,2)"x c2BYTES / c1"right(ftimes,2)"xc2 FILES GONE!! c7<<<<<<c7"
  408.     if ftimes=frat & btimes=brat then do
  409.        word="n1>34}c7>>>>>>c2     FULL CREDITS GONE!!   c7   <<<<<<"
  410.     end
  411.  
  412. if btimes<0 then do
  413.     btimes=abs(btimes)
  414.     ftimes=abs(ftimes)
  415.     word="n1>34}c7>>>>>>c3 "right(btimes,2)"x c2BYTES / c3"right(ftimes,2)"xc2 FILES GIVEN! c7<<<<<<c7"
  416. end
  417. line1=line1""word
  418. transmit "n1Result:n2"line1
  419. open("o",name,"W")
  420. writeln("o",line1)
  421. close("o")
  422.  
  423. mail:
  424. janein="Yes"
  425. if quick=1 then do
  426.     call p4
  427. end
  428. if ag=sysop then do
  429.     prompt 2 yesno "n1Send Nuke-Mail to user ("ackc"/n)?:"; janein=result
  430. end
  431. p4:
  432. if janein="Yes" then do
  433.     open("raus","ram:nukemail","W")
  434.     getuser 1 ; handle=result
  435.     nukb=size*btimes
  436.     nukf=ftimes
  437.     mail="       File:c2 "nname"c7n1       Size:c2 "size"c7n1Upload Date:c2 "date"c7n1       Info:c2 "info"c7n1n1Times nuked (File/Byte):c2 "ftimes"/"btimes"c7n1            Bytes nuked:c2 "nukb"c7n1            Files nuked:c2 "nukf"c7n1            BCreds left:c2 v35}c7n1            FCreds left: c2v34}c7n2   Nuked by: c2"handle"c7n2"line1"n2   c3Killer V2.0a by Quickfinger/LATEXc2n1Paranoia Complex BBS +49(0)625175324 1/3c7"
  438.     writeln("raus",mail)
  439.     close("raus")
  440.     setmailsubj "Byte-Credits"
  441.     loadeditor "ram:nukemail"
  442.     writemail byacc
  443.     transmit "f1n1Message to User "user
  444.     transmit "n1*0ram:nukemail}"
  445.     address command "c:delete ram:nukemail"
  446.     if handle~="Quickfinger" then do
  447.         sendstring "n1Sending receipt to sysop..."
  448.         open("o","ram:sysmsg","W")
  449.         sysopmessg="c2"handle"c7 nuked c1"byname"'sc7 upload c3"nname"c7 c1"btimes"c7x Bytes, c1"ftimes"c7x Files"
  450.         writeln("o",sysopmessg)
  451.         close("o")
  452.         cleareditor
  453.         loadeditor "ram:sysmsg"            
  454.         setmailsubj "Nuke-Receipt"
  455.         writemail 1
  456.         address command "c:delete ram:sysmsg"
  457.         transmit "sent."
  458.     end
  459.     if noreturn~=1 then do
  460.         mailret="You downloaded the following file and it was nuked.  Therefore you aren1c2returnedc7 the credits.n2       File:c2 "nname"c7n1       Size:c2 "size"c7n1Upload Date:c2 "date"c7n1       Info:c2 "info"c7n2Bytes c2RETURNEDc7 :c2 "size"c7n1Files c2RETURNEDc7 :c2 1c7n1    BCreds left:c2 v35}c7n1    FCreds left:c2 v34}c7n2   Nuked by: c2"handle"c7n2"line1"n2   c3Killer V2.0a by Quickfinger/LATEXc2n1Paranoia Complex BBS +49(0)625175324 1/3c7"
  461.         open("o","ram:mailret","W")
  462.         writeln("o",mailret)
  463.         close("o")
  464.         do a=1 to count
  465.             sendstring "n1Sending return-receipt to "name.a"..."
  466.             setmailsubj "Credits returned"    
  467.             cleareditor
  468.             loadeditor "ram:mailret"
  469.             writemail account.a
  470.             transmit "sent!                        ^1"
  471.         end
  472.         transmit ""
  473.     
  474.         address command "c:delete ram:mailret"
  475.     end
  476. end
  477.  
  478.  
  479. ende:
  480. exit
  481.  
  482.